package hashes;
use strict;
# written by Anton Sedlak <ased@cce.cz>
our (@ISA, @EXPORT, @EXPORT_OK);
use Exporter ();
@ISA = qw(Exporter);
@EXPORT = qw(hash_lookup
	hash_add hash_nadd 
	hash_copy hash_del 
	hash_copy_regex hash_del_regex
	hash_regex 
	hash_rename 
	hash_val
	hash_dmerge hash_dnmerge hash_dset hash_ddelete
	ohash_set);


# create hash of lookup keys
sub hash_lookup {
  my %h;
  $h{$_}=1 for @_;
  return \%h
}

# merge several hashes in place for first item
# h1 + h2 + ... hn
# !!! equal keys are replaced !!!
sub hash_add {
    for (my $i=1; $i <= $#_; $i++) {
	while( my ($k,$v) = each %{ $_[$i] } ) {  $_[0]->{$k}=$v }
    }
    $_[0];
}
# as previous but existing keys are not overwriten !!!
sub hash_nadd {
    for (my $i=1; $i <= $#_; $i++) {
	while( my ($k,$v) = each %{ $_[$i] } ) {  
	    $_[0]->{$k}=$v unless exists $_[0]->{$k};
	}
    }
    $_[0];
}

# copy several values of given keys
# h1 = h2{k1 .. kn}
# hash_copy(h1,h2,k1,... kn)
# hash_copy({},{a=>1,b=>2},qw(a b));
sub hash_copy {
    for (my $i=2; $i <= $#_; $i++) {
	$_[0]->{$_[$i]} = $_[1]->{$_[$i]};
    }
    $_[0];
}

# delete keys
# h{k1 .. kn}
# hash_del(h1,k1,... kn)
# hash_del({a=>1,b=>2},qw(a b));
sub hash_del {
    for (my $i=1; $i <= $#_; $i++) {
	delete $_[0]->{$_[$i]};
    }
    $_[0];
}

sub hash_del_regex {
  hash_del($_[0],hash_regex($_[0],$_[1]));
}

# hash_copy_regexp(h1,h2,re)
sub hash_copy_regex {
    hash_copy($_[0],$_[1],hash_regex($_[1],$_[2]));
}

# return all keys which satisfy given regexp
# hash_regexp(h,regex  or string);
sub hash_regex {
    grep { /$_[1]/ } ( keys %{ $_[0] } );
}

# return all values for given keys
# hash_regexp(h,k1, k2, .. kn);
sub hash_val {
    my @new;
    for (my $i=1; $i <= $#_; $i++) {
	push @new,$_[0]->{$_[$i]};
    }
    return @new;
}


# rename keys in place of hash
# rename k1,..kn -> q1,.. qn where kx - old keys and qx - new keys
# hash_rename h,k1,..kn,q1,...,qn
sub hash_rename {
    my $n = int ($#_ / 2);
    my %new;
    for (my $i=1; $i<=$n; $i++) {
	next unless exists $_[0]->{$_[$i]};
	$new{$_[$i+$n]} = $_[0]->{$_[$i]}; # copy to new place
	delete $_[0]->{$_[$i]};
    }
    hash_add($_[0],\%new);
}

# DEEP HASHES

#print Data::Dumper->Dump([$d],[qw(d)]);
# deep merge
# equal keys are not replaced incase of HASH
# hash_dmerge({a=>{ b=>1 }}, {a=>{c=>2}})
# will merge coresponding hashes {a=>{ b=>1,c=>2} }
sub hash_dmerge {
    my $ref1 = ref $_[0]; #ref type - HASH ARRAY SCALAR ...
    my $rval1 = $ref1 ? $_[0] : \$_[0]; # ref value -> then use %$rval or @$rval
    shift;
    my $ref2 = ref $_[0]; #ref type - HASH ARRAY SCALAR ...
    my $rval2 = $ref2 ? $_[0] : \$_[0]; # ref value -> then use %$rval or @$rval
    shift;
    my $seen1 = shift || {}; # for references
    if($ref1){ # check duplicities - cycle references
	return if exists $seen1->{$rval1};
	$seen1->{$rval1}=1;
    }
    if($ref1 eq 'HASH' and $ref2 eq 'HASH') {
	while( my ($k2,$v2) = each %$rval2 ) {
	    if(exists $rval1->{$k2}) {
		my $v1 = $rval1->{$k2};
		if(ref $v1 eq 'HASH' and ref $v2 eq 'HASH') {
		    hash_dmerge($v1,$v2,$seen1);
		}
		else {
		    $rval1->{$k2}=$rval2->{$k2};
		}
	    }
	    else {
		$rval1->{$k2}=$rval2->{$k2};
	    }
	}
    }
    return;
}

# deep merge as dmerge - but no replacement of equal keys
# equal keys are not replaced !!! keep original values
#   - this mean you can only add (key,values)
sub hash_dnmerge {
    my $ref1 = ref $_[0]; #ref type - HASH ARRAY SCALAR ...
    my $rval1 = $ref1 ? $_[0] : \$_[0]; # ref value -> then use %$rval or @$rval
    shift;
    my $ref2 = ref $_[0]; #ref type - HASH ARRAY SCALAR ...
    my $rval2 = $ref2 ? $_[0] : \$_[0]; # ref value -> then use %$rval or @$rval
    shift;
    my $seen1 = shift || {}; # for references
    if($ref1){ # check duplicities - cycle references
	return if exists $seen1->{$rval1};
	$seen1->{$rval1}=1;
    }
    if($ref1 eq 'HASH' and $ref2 eq 'HASH') {
	while( my ($k2,$v2) = each %$rval2 ) {
	    if(exists $rval1->{$k2}) {
		hash_dnmerge($rval1->{$k2},$v2,$seen1);
	    }
	    else {
		$rval1->{$k2}=$rval2->{$k2};
	    }
	}
    }
    return;
}

# deep set hash keys to value
# !!! value is set only if key exists
sub hash_dset {
  my ($h,$v) = splice(@_,0,2);
  my $lookup = hash_lookup(@_);
  _hash_dset($h,$v,$lookup);
}
sub _hash_dset {
  my $ref = ref $_[0]; #ref type - HASH ARRAY SCALAR ...
  my $rval = $ref ? $_[0] : \$_[0]; # ref value -> then use %$rval or @$rval
  shift;
  my $val   =shift; # value to set
  my $lookup=shift; # this keys
  my $seen = shift || {}; # for references
  if($ref){ # check duplicities - cycle references
    return if exists $seen->{$rval};
    $seen->{$rval}=1;
  }
  if($ref eq 'HASH') {
    while( my ($k,$v) = each %$rval ) {
      if(exists $lookup->{$k}) {
	$rval->{$k}=$val;
      }
      else {
	_hash_dset($rval->{$k},$val,$lookup,$seen);
      }
    }
  }
  return;
}

# delete all existance of given keys
sub hash_ddelete {
  my $h = shift;
  my $keys = [@_];
  _hash_ddelete($h,$keys);
}
sub _hash_ddelete {
  my $ref = ref $_[0]; #ref type - HASH ARRAY SCALAR ...
  my $rval = $ref ? $_[0] : \$_[0]; # ref value -> then use %$rval or @$rval
  shift;
  my $keys=shift; # this keys
  my $seen = shift || {}; # for references
  if($ref){ # check duplicities - cycle references
    return if exists $seen->{$rval};
    $seen->{$rval}=1;
  }
  if($ref eq 'HASH') {
    delete @$rval{@$keys};
    while( my ($k,$v) = each %$rval ) {
	_hash_ddelete($rval->{$k},$keys,$seen);
    }
  }
  return;
}

# second level hash of hashes - so called OPTION HASH
# because each may may have several values
# _set(hash,key2,val,k1..
# for each key 'k1' level1 set {key2}=val2
# ohash_set({id=>{a=>1}},'enable',1,qw()}
sub ohash_set {
  my ($h,$k2,$v2) = splice(@_,0,3);
  $h->{$_}{$k2}=$v2 for @_;
}

1;

